(in-package :gwee)
  
(defun draw-filled-aa-polygon (points &key (color (gwee:gray 0)) (outline color))
  (sdl:draw-filled-polygon points :color color)
  (sdl:draw-aa-polygon points :color outline))

(defun draw-filled-aa-trigon (p1 p2 p3 &key (color (gwee:gray 0)))
  (sdl:draw-filled-trigon p1 p2 p3 :color color)
  (sdl:draw-aa-trigon p1 p2 p3 :color color))

(defun draw-filled-aa-circle (x y r &key (color (gwee:gray 0)))
  (sdl:draw-filled-circle-* x y r :color color)
  (sdl:draw-aa-circle-* x y r :color color))

(defun draw-filled-aa-ellipse (x y rx ry &key (color (gwee:gray 0)))
  (sdl:draw-filled-ellipse-* x y rx ry :color color)
  (sdl::draw-aa-ellipse-* x y rx ry :color color))

(defgeneric draw-line-ending-style (x1 y1 x2 y2 thickness angle color style)
  (:documentation "Return the length the main line should be shortened to accomodate the ending style for each end."))

(defmethod draw-line-ending-style (x1 y1 x2 y2 thickness angle color (style (eql :round)))
  (declare (ignore angle))
  (draw-filled-aa-circle x1 y1 (truncate thickness) :color color)
  (draw-filled-aa-circle x2 y2 (truncate thickness) :color color)
  (values thickness thickness))

(defmethod draw-line-ending-style (x1 y1 x2 y2 thickness angle color (style (eql :arrow)))
  (let ((ax (* thickness 6 (cos (+ angle (/ pi 2.9)))))
	(ay (* thickness 6 (sin (+ angle (/ pi 2.9)))))
	(bx (* thickness 6 (cos (- angle (/ pi 2.9)))))
	(by (* thickness 6 (sin (- angle (/ pi 2.9))))))
    (draw-filled-aa-trigon (sdl:point :x x2 :y y2)
			   (sdl:point :x (+ x2 ax) :y (+ y2 ay))
			   (sdl:point :x (- x2 bx) :y (- y2 by))
			   :color color)
    (values 0 (* thickness 4))))

(defgeneric foreground-for-view (view)
  (:documentation "Return the foreground color to use for the specified view"))

(defmethod foreground-for-view ((view t))
  *default-foreground-color*)

(defmethod foreground-for-view ((view foreground-mixin))
  (foreground-color view))

;;; Public drawing functions

(defun line-intersection (x1 y1 x2 y2 x3 y3 x4 y4)
  (let* ((denom (- (* (- y4 y3) (- x2 x1)) (* (- x4 x3) (- y2 y1))))
         (ua-num (- (* (- x4 x3) (- y1 y3)) (* (- y4 y3) (- x1 x3))))
         (ub-num (- (* (- x2 x1) (- y1 y3)) (* (- y2 y1) (- x1 x3)))))
    (cond
      ;; If the denominator and numerator for the equations for ua and
      ;; ub are 0 then the two lines are coincident.
      ((and (zerop denom) (zerop ua-num) (zerop ub-num)) (list x1 y1))
      ;; If the denominator for the equations for ua and ub is 0 then
      ;; the two lines are parallel.
      ((zerop denom) nil)
      (t
       (let ((ua (/ ua-num denom))
             ;; (ub (/ ub-num denom))
             )
         (list (+ x1 (* ua (- x2 x1)))
               (+ y1 (* ua (- y2 y1)))))))))

(defun intersection-points (sx sy mx my ex ey thickness)
  (let* ((sdx (- mx sx))
         (sdy (- my sy))
         (sangle (if (zerop sdx)
                     0
                     (+ (atan (/ sdy sdx)) (/ pi 2))))
         (slx (+ sx (* thickness (cos sangle))))
         (sly (+ sy (* thickness (sin sangle))))
         (srx (+ sx (* (- thickness) (cos sangle))))
         (sry (+ sy (* (- thickness) (sin sangle))))
         (edy (- ey my))
         (edx (- ex mx))
         (eangle (if (zerop edx)
                     0
                     (+ (atan (/ edy edx)) (/ pi 2))))
         (elx (+ ex (* thickness (cos eangle))))
         (ely (+ ey (* thickness (sin eangle))))
         (erx (+ ex (* (- thickness) (cos eangle))))
         (ery (+ ey (* (- thickness) (sin eangle))))
         (intersect (cond
                      ;; ((and (= my ey)
                      ;;       (= mx ex))
                      ;;  :lr-rl)
                      ((and (< sx mx)
                            (< ex mx)
                            (< sy my ey))
                       :lr-rl)
                      ((and (< sx mx)
                            (< ex mx)
                            ;; (> sy my ey)
                            )
                       :lr-rl)
                      ((and (< sx mx)
                            (= ex mx)
                            (< sy my ey))
                       :lr-rl)
                      ((and (> sx mx)
                            (> ex mx)
                            (< sy my ey))
                       :rl-lr)
                      ((and (> sx mx)
                            (> ex mx)
                            ;; (> sy my ey)
                            )
                       :rl-lr)
                      ((and (> sy my)
                            (> ey my)
                            (> sx mx ex))
                       :rr-ll)
                      ((and (< sy my)
                            (< ey my)
                            (> sx mx ex))
                       :rr-ll)
                      ((and (< sy my)
                            (< ey my)
                            (>= sx mx ex))
                       :rl-lr)
                      ((and (> sy my ey)
                            (> sx mx ex))
                       :rr-ll)
                      ((and (< sy my ey)
                            (> sx mx ex))
                       :rr-ll)
                      ;; ((and (< sy my)
                      ;;       (< ey my)
                      ;;       (> sx mx ex))
                      ;;  :rr-ll)
                      ((and (= sy my)
                            (= mx ex)
                            (< sx mx)
                            (< my ey))
                       :lr-rl)
                      ((and (= sx mx)
                            (= my ey)
                            (< sy my)
                            (> mx ex))
                       :rr-ll)
                      ((and (= sy my)
                            (= mx ex)
                            (> sx mx)
                            (> my ey))
                       :rl-lr)
                      ((and (= sx mx)
                            (= my ey)
                            (> sy my)
                            (> mx ex))
                       :lr-rl)
                      ((and (= sy my)
                            (= mx ex)
                            (> sx mx)
                            (< my ey))
                       :rr-ll)
                      ((and (= sx mx)
                            (= my ey)
                            (< sy my)
                            (< mx ex))
                       :rl-lr)
                      (t :ll-rr)))
         (left (or (ecase intersect
                     (:ll-rr
                      (line-intersection slx sly (+ slx sdx) (+ sly sdy) elx ely (+ elx edx) (+ ely edy)))
                     (:rr-ll
                      (line-intersection srx sry (+ srx sdx) (+ sry sdy) erx ery (+ erx edx) (+ ery edy)))
                     (:rl-lr
                      (line-intersection srx sry (+ srx sdx) (+ sry sdy) elx ely (+ elx edx) (+ ely edy)))
                     (:lr-rl
                      (line-intersection slx sly (+ slx sdx) (+ sly sdy) erx ery (+ erx edx) (+ ery edy))))
                   (list (+ mx (* thickness (cos sangle)))
                         (+ my (* thickness (sin sangle))))))
         (right (or (ecase intersect
                      (:ll-rr
                       (line-intersection srx sry (+ srx sdx) (+ sry sdy) erx ery (+ erx edx) (+ ery edy)))
                      (:rr-ll
                      (line-intersection slx sly (+ slx sdx) (+ sly sdy) elx ely (+ elx edx) (+ ely edy)))
                      (:rl-lr
                       (line-intersection slx sly (+ slx sdx) (+ sly sdy) erx ery (+ erx edx) (+ ery edy)))
                      (:lr-rl
                       (line-intersection srx sry (+ srx sdx) (+ sry sdy) elx ely (+ elx edx) (+ ely edy))))
                    (list (+ mx (* (- thickness) (cos sangle)))
                          (+ my (* (- thickness) (sin sangle)))))))
    ;; (draw-intersection slx sly sdx sdy elx ely edx edy (gwee:color 0 100 0))
    ;; (draw-intersection srx sry sdx sdy erx ery edx edy (gwee:color 0 2 0))
    ;;(print `(inter ,intersect s ,sx ,sy m ,mx ,my e ,ex ,ey sa ,(* sangle (/ 180 pi)) ea ,(* eangle (/ 180 pi))))
    (values left right
            (list slx sly)
            (list srx sry)
            (list elx ely)
            (list erx ery))))

(defun test-thick ()
  (gwee:with-gui (1024 768)
    (let (pts)
      (labels ((drawit ()
                 (sdl:clear-display (gwee:gray 0) :surface gwee::*surface*)
                 (when (>= (length pts) 3)
                   (draw-thick-polygon gwee:*top-view* pts
                                       :color (gwee:color 255 0 0)
                                       :thickness 5
                                       :outline (gwee:color 0 255 0)))
                 (gwee::update-display)))
      (sdl:with-events ()
        (:active-event ()
                       (sdl:update-display))
        (:quit-event ()
                     (return-from test-thick nil))
        (:key-down-event (:key key)
                         (when (eq key :sdl-key-escape)
                           (setf pts nil))
                         (drawit))
        ;; (:mouse-motion-event (:x x :y y)
        ;;                      (setf pts (nconc pts `((,x ,y))))
        ;;                      (drawit))
        (:mouse-button-down-event (:x x :y y)
                                  (setf pts (nconc pts `((,x ,y))))
                                  (drawit)))))))

(defun draw-points (c &rest pts)
  (dolist (i pts)
    (sdl:draw-pixel-* (truncate (first i)) (truncate (second i)) :color c)))

(defun test-draw-line (x y delta color)
  (sdl:draw-line-* (truncate x) (truncate y) (truncate (+ x (* (denominator delta) 200))) (truncate (+ y (* (numerator delta) 200)))
                   :color color)
  (sdl:draw-line-* (truncate x) (truncate y) (truncate (- x (* (denominator delta) 200))) (truncate (- y (* (numerator delta) 200)))
                   :color color))

(defun draw-intersection (x1 y1 dx1 dy1 x2 y2 dx2 dy2 color)
  (test-draw-line x1 y1 (/ dy1 dx1) (gwee:gray 100))
  (test-draw-line x2 y2 (/ dy2 dx2) (gwee:gray 100))
  (let ((i (line-intersection x1 y1 (+ x1 dx1) (+ y1 dy1) x2 y2 (+ x2 dx2) (+ y2 dy2))))
    (sdl:draw-pixel-* (truncate (first i)) (truncate (second i)) :color (gwee:gray 255))))

(defun thick-star (view cx cy inner-radius outer-radius points thickness)
  (draw-thick-polygon view
                      (loop for angle from 0 below 360 by (/ 360 (* points 2))
                            for c from 0
                            for radius = (if (oddp c) outer-radius inner-radius)
                            collect (list (+ cx (* (cos (* angle (/ pi 180))) radius))
                                          (+ cy (* (sin (* angle (/ pi 180))) radius))))
                      :thickness thickness
                      :color (gwee:color 255 0 0)
                      :outline (gwee:color 0 255 0)))

(defun thick-gon (view cx cy radius points thickness)
  (draw-thick-polygon view
                      (loop for angle from 0 below 360 by (/ 360 points)
                            collect (list (+ cx (* (cos (* angle (/ pi 180))) radius))
                                          (+ cy (* (sin (* angle (/ pi 180))) radius))))
                      :thickness thickness
                      :color (gwee:color 255 0 0)
                      :outline (gwee:color 0 255 0)))

(defun test-intersection ()
  (gwee:with-gui (1024 768)
    (draw-thick-polygon *top-view* `((100 100) (200 100)
                                     (200 200) (100 200))
                        :thickness 5
                        :color (gwee:color 0 255 255)
                        :outline (gwee:color 255 0 255))
    (draw-thick-polygon *top-view* '((900 200) (1000 200)
                                     (1000 100) (900 100))
                        :thickness 5
                        :color (gwee:color 0 255 255)
                        :outline (gwee:color 255 0 255))
    (thick-star *top-view* 200 200 100 50 5 4)
    (thick-star *top-view* 300 300 100 50 7 4)
    (thick-star *top-view* 200 400 100 50 4 4)
    (thick-star *top-view* 700 400 100 50 11 4)
    (thick-gon *top-view* 400 200 100 8 20)
    (thick-gon *top-view* 700 200 100 6 4)
    (gwee::update-display)))


;; FIXME: still has some bugs. try TEST-INTERSECTION.
(defun draw-thick-polygon (view points &key (filled t) (closed t) (thickness nil thickness-supplied) (color (foreground-for-view view)) outline)
  (assert thickness-supplied ()
          "THICKNESS must be supplied.")
  (loop for rest on points
        for lp = (if closed (u:last1 points) (first points)) then p
        for p = (first rest) then np
        for np = (or (second rest) (if closed (first points) (u:last1 points)))
        for pts = (multiple-value-list (intersection-points (first lp) (second lp)
                                                            (first p) (second p)
                                                            (first np) (second np)
                                                            thickness))
        collect (first pts) into left
        collect (second pts) into right
        finally (if closed
                    (labels ((convert (points)
                               (mapcar (lambda (p)
                                         (sdl:point :x (view-to-top-x view (first p))
                                                    :y (view-to-top-y view (second p))))
                                       points)))
                      (setf left (convert left)
                            right (convert right))
                      (when filled
                        (sdl:draw-filled-polygon (append left
                                                         (list (first left)
                                                               (first right))
                                                         (reverse right))
                                                 :color color))
                      (sdl:draw-aa-polygon left :color (or outline color))
                      (sdl:draw-aa-polygon right :color (or outline color)))
                    (gwee:draw-polygon view (append left (reverse right))
                                       :color color
                                       :outline outline
                                       :filled filled))))

(defun draw-polygon (view points &key (color (foreground-for-view view)) filled outline)
  (let ((pts (loop for i in points
                   collect (sdl:point :x (view-to-top-x view (first i))
                                      :y (view-to-top-y view (second i))))))
    (if (and outline filled)
        (draw-filled-aa-polygon pts :color color :outline outline)
        (funcall (if filled
                     'draw-filled-aa-polygon
                     'sdl:draw-aa-polygon)
                 pts
                 :color color))))

(defun draw-bezier (view points &key (color (foreground-for-view view)))
  (sdl:draw-bezier (loop for i in points
                          collect (sdl:point :x (view-to-top-x view (first i))
                                             :y (view-to-top-y view (second i))))
                       :color color))

(defun draw-circle (view x y r &key (color (foreground-for-view view)) filled)
  (funcall (if filled
              'draw-filled-aa-circle
              'sdl:draw-aa-circle-*)
           (view-to-top-x view x)
           (view-to-top-y view y)
           r
           :color color))

(defun draw-ellipse (view x y rx ry &key (color (foreground-for-view view)) filled)
  (funcall (if filled
              'draw-filled-aa-ellipse
              'sdl::draw-aa-ellipse-*)
           (view-to-top-x view x)
           (view-to-top-y view y)
           rx ry
           :color color))

(defun draw-trigon (view x1 y1 x2 y2 x3 y3 &key (color (foreground-for-view view)) filled)
  (apply (if filled
             'draw-filled-aa-trigon
             'sdl:draw-aa-trigon)
         (append
          (loop for x in (list x1 x2 x3)
             for y in (list y1 y2 y3)
             collect (sdl:point :x (view-to-top-x view x)
                                :y (view-to-top-y view y)))
          (list :color color))))

(defun draw-rectangle (view x y width height &key (color (foreground-for-view view)) filled)
  (funcall (if filled
               'sdl:draw-box-*
               'sdl:draw-rectangle-*)
           (view-to-top-x view x)
           (view-to-top-y view y)
           width height
           :color color))

(defun draw-bubble-rectangle (view x y width height &key (radius 5) filled (color (foreground-for-view view)))
  (setf x (view-to-top-x view x)
        y (view-to-top-y view y))
  (if filled
      (progn
        ;; middle
        (sdl:draw-box-* (+ x radius) y (- width (* 2 radius)) height :color color)
        (sdl:draw-box-* x (+ y radius) radius (- height (* 2 radius)) :color color)
        (sdl:draw-box-* (- (+ x width) radius) (+ y radius) radius (- height (* 2 radius)) :color color)
        ;; corners
        (sdl:draw-filled-circle-* (+ x radius 1) (+ y radius) radius :color color)
        (sdl:draw-filled-circle-* (+ x width (- radius) -2) (+ y radius) radius :color color)
        (sdl:draw-filled-circle-* (+ x width (- radius) -2) (+ y height (- radius) -1) radius :color color)
        (sdl:draw-filled-circle-* (+ x radius 1) (+ y height (- radius) -1) radius :color color)


        ;; (sdl:draw-filled-pie-* (+ x radius) (+ y radius) radius 180 270 :color color)
        ;; (sdl:draw-filled-pie-* (+ x width (- radius) -1) (+ y radius) radius 270 360 :color color)
        ;; (sdl:draw-filled-pie-* (+ x width (- radius) -1) (+ y height (- radius) -1) radius 0 89 :color color)
        ;; (sdl:draw-filled-pie-* (+ x radius) (+ y height (- radius) -1) radius 90 180 :color color)
        )
      (progn
        ;; sides
        (sdl:draw-hline (+ x radius) (+ x width (- radius)) y :color color)
        (sdl:draw-hline (+ x radius) (+ x width (- radius)) (+ y height) :color color)
        (sdl:draw-vline x (+ y radius) (+ y height (- radius)) :color color)
        (sdl:draw-vline (+ x width) (+ y radius) (+ y height (- radius)) :color color)
        ;; corners
        (sdl:draw-arc-* (+ x radius) (+ y radius) radius 180 270 :color color)
        (sdl:draw-arc-* (+ x width (- radius)) (+ y radius) radius 270 360 :color color)
        (sdl:draw-arc-* (+ x width (- radius)) (+ y height (- radius)) radius 0 90 :color color)
        (sdl:draw-arc-* (+ x radius) (+ y height (- radius)) radius 90 180 :color color))))

(defun draw-rectangle-* (view x y width height &key (thickness 1) (color (foreground-for-view view)) filled style)
  ;; TODO: implement style
  (declare (ignore style filled))
  (setf x (view-to-top-x view x)
        y (view-to-top-y view y))
  (loop for i below thickness do
       (sdl:draw-rectangle-* (+ x i) (+ y i) (- width i i) (- height i i) :color color)))

(defun draw-hline (view x1 x2 y &key (color (foreground-for-view view)))
  (sdl:draw-hline (view-to-top-x view x1) (view-to-top-x view x2)
                      (view-to-top-y view y)
                      :color color))

(defun draw-vline (view x y1 y2 &key (color (foreground-for-view view)))
  (sdl:draw-vline (view-to-top-x view x)
                  (view-to-top-y view y1) (view-to-top-y view y2)
                      :color color))

(defun draw-line (view x1 y1 x2 y2 &key (color (foreground-for-view view)))
  (sdl:draw-aa-line-* (view-to-top-x view x1)
                          (view-to-top-y view y1)
                          (view-to-top-x view x2)
                          (view-to-top-y view y2)
                          :color color))

(defun draw-lines-* (view points &key (color (foreground-for-view view)) (thickness 1))
  (loop for last = (first points) then p
     for p in (cdr points)
     do (sdl:draw-aa-line-* (view-to-top-x view (first last))
                                (view-to-top-y view (second last))
                                (view-to-top-x view (first p))
                                (view-to-top-y view (second p))
                                :color color)))

(defun draw-line-* (view x1 y1 x2 y2 &key (thickness 1) (color (foreground-for-view view)) (outline color) style)
  (setf thickness (/ thickness 2)
        x1 (view-to-top-x view x1)
        y1 (view-to-top-y view y1)
        x2 (view-to-top-x view x2)
        y2 (view-to-top-y view y2))
  (let* ((angle (- (atan (- x1 x2) (- y1 y2))))
	 (w (* thickness (cos angle)))
	 (h (* thickness (sin angle))))
    (when style
      (multiple-value-bind (start end) (draw-line-ending-style x1 y1 x2 y2 thickness angle color style)
	(decf x1 (* start (cos (- angle (/ pi 2)))))
	(decf y1 (* start (sin (- angle (/ pi 2)))))
	(decf x2 (* end (cos (- angle (/ pi 2)))))
	(decf y2 (* end (sin (- angle (/ pi 2)))))))
    (let ((points (list (sdl:point :x (- x1 w) :y (- y1 h))
                        (sdl:point :x (+ x1 w) :y (+ y1 h))
                        (sdl:point :x (+ x2 w) :y (+ y2 h))
                        (sdl:point :x (- x2 w) :y (- y2 h)))))
    (sdl:draw-filled-polygon points :color color)
    (sdl:draw-aa-polygon points :color outline))))

(defun draw-text (view text x y &key (font (if (slot-exists-p view 'font)
                                               (view-font view)
                                               (default-font)))
                  (color (foreground-for-view view))
                  (y-alignment :top) (x-alignment :left))
  (when (plusp (length text))
    (sdl:draw-string-blended-* text
                               (+ (view-to-top-x view x)
                                  (ecase x-alignment
                                    (:left 0)
                                    (:center (- (u:half (sdl:get-font-size text :size :w :font font))))
                                    (:right (- (sdl:get-font-size text :size :w font)))))
                               (+ (view-to-top-y view y)
                                  (ecase y-alignment
                                    (:top 0)
                                    (:center (- (u:half (sdl:get-font-size text :size :h :font font))))
                                    (:right (- (sdl:get-font-size text :size :h :font font)))))
                               :font font :color color)))
